module strategy

    implicit none

    abstract interface
        pure subroutine operate(a, b, c) bind(c)
            real, intent(in) :: a, b
            real, intent(out) :: c
        end subroutine operate
    end interface

    procedure(operate), pointer :: op => null()

contains

    pure subroutine add(a, b, c)
        real, intent(in) :: a, b
        real, intent(out) :: c
        ! c = a + b
    end subroutine add

    pure subroutine subtract(a, b, c)
        real, intent(in) :: a, b
        real, intent(out) :: c
        ! c = a + b
    end subroutine subtract

    pure subroutine multiply(a, b, c)
        real, intent(in) :: a, b
        real, intent(out) :: c
        ! c = a + b
    end subroutine multiply

    pure subroutine divide(a, b, c)
        real, intent(in) :: a, b
        real, intent(out) :: c
        ! c = a + b
    end subroutine divide

end module strategy

program main

    use seakeeping_time, only: tic, toc
    use strategy
    implicit none

    print *, '*** m = 100000, n = 100000'
    call bench(m=100, n=10000000)

contains

    subroutine test_if_add(m, n)
        integer, intent(in) :: m, n
        integer :: i, j, op_type
        real :: a, b, c

        a = 1
        b = 2
        op_type = 1
        do j = 1, m
            do i = 1, n
                if (op_type == 1) then
                    call add(a, b, c)
                else if (op_type == 2) then
                    call subtract(a, b, c)
                else if (op_type == 3) then
                    call multiply(a, b, c)
                else if (op_type == 4) then
                    call divide(a, b, c)
                end if
            end do
        end do

    end subroutine test_if_add

    subroutine test_if_subtract(m, n)
        integer, intent(in) :: m, n
        integer :: i, j, op_type
        real :: a, b, c

        a = 1
        b = 2
        op_type = 2
        do j = 1, m
            do i = 1, n
                if (op_type == 1) then
                    call add(a, b, c)
                else if (op_type == 2) then
                    call subtract(a, b, c)
                else if (op_type == 3) then
                    call multiply(a, b, c)
                else if (op_type == 4) then
                    call divide(a, b, c)
                end if
            end do
        end do

    end subroutine test_if_subtract

    subroutine test_if_multiply(m, n)
        integer, intent(in) :: m, n
        integer :: i, j, op_type
        real :: a, b, c

        a = 1
        b = 2
        op_type = 3
        do j = 1, m
            do i = 1, n
                if (op_type == 1) then
                    call add(a, b, c)
                else if (op_type == 2) then
                    call subtract(a, b, c)
                else if (op_type == 3) then
                    call multiply(a, b, c)
                else if (op_type == 4) then
                    call divide(a, b, c)
                end if
            end do
        end do

    end subroutine test_if_multiply

    subroutine test_if_divide(m, n)
        integer, intent(in) :: m, n
        integer :: i, j, op_type
        real :: a, b, c

        a = 1
        b = 2
        op_type = 4
        do j = 1, m
            do i = 1, n
                if (op_type == 1) then
                    call add(a, b, c)
                else if (op_type == 2) then
                    call subtract(a, b, c)
                else if (op_type == 3) then
                    call multiply(a, b, c)
                else if (op_type == 4) then
                    call divide(a, b, c)
                end if
            end do
        end do

    end subroutine test_if_divide

    subroutine test_select_case(m, n)
        integer, intent(in) :: m, n
        integer :: i, j, op_type
        real :: a, b, c

        a = 1
        b = 2
        op_type = 1
        do j = 1, m
            do i = 1, n
                select case (op_type)
                case (1)
                    call add(a, b, c)
                case (2)
                    call subtract(a, b, c)
                case (3)
                    call multiply(a, b, c)
                case (4)
                    call divide(a, b, c)
                end select
            end do
        end do

    end subroutine test_select_case

    subroutine test_procedure_pointer_add(m, n)
        integer, intent(in) :: m, n
        integer :: i, j
        real :: a, b, c

        a = 1
        b = 2
        op => add
        do j = 1, m
            do i = 1, n
                call op(a, b, c)
            end do
        end do

    end subroutine test_procedure_pointer_add

    subroutine test_procedure_pointer_subtract(m, n)
        integer, intent(in) :: m, n
        integer :: i, j
        real :: a, b, c

        a = 1
        b = 2
        op => subtract
        do j = 1, m
            do i = 1, n
                call op(a, b, c)
            end do
        end do

    end subroutine test_procedure_pointer_subtract

    subroutine bench(m, n)
        integer, intent(in) :: m, n

        call tic()
        call test_if_add(m, n)
        call toc('if-then-else, add')

        call tic()
        call test_if_subtract(m, n)
        call toc('if-then-else, subtract')

        call tic()
        call test_if_multiply(m, n)
        call toc('if-then-else, multiply')

        call tic()
        call test_if_divide(m, n)
        call toc('if-then-else, divide')

        call tic()
        call test_select_case(m, n)
        call toc('select case')

        call tic()
        call test_procedure_pointer_add(m, n)
        call toc('procedure pointer, add')

        call tic()
        call test_procedure_pointer_subtract(m, n)
        call toc('procedure pointer, subtract')

    end subroutine bench

end program main

!  *** m = 100000, n = 100000
! if-then-else, add, time elapsed: 2.33 s
! if-then-else, subtract, time elapsed: 3.78 s
! if-then-else, multiply, time elapsed: 2.78 s
! if-then-else, divide, time elapsed: 3.47 s
! select case, time elapsed: 3.62 s
! procedure pointer, add, time elapsed: 2.33 s
! procedure pointer, subtract, time elapsed: 2.39 s
! 函数指针略优于判断